perm filename R[226,DBL] blob
sn#043418 filedate 1973-05-21 generic text, type T, neo UTF8
06700 (DE DOUBLE (PP DD) (PROG ()
06800 (SETQ P (CONS (PRINT (NTH DECK (RR))) P ))
06900 (SETQ WAGER1 (PLUS WAGER WAGER))
07000 (COND ((OVER P) (PRINT (QUOTE (YOU ARE OVER)))
07050 (SETQ U (ADD1 U)) (STAT -1))
07100 (T (SETQ U (ADD1 U))))
07200 (STICK P D]
07300
07400 (DE SPLIT (PP DD) (PROG (P1)
07500 (PRINT (QUOTE (OK WE WILL WORK ON FIRST)))
07600 (SETQ H (CONS (PRINT (CAR P)) H ))
07700 M (PRINT (QUOTE (YOU GET)))
07800 (PRINT (NTH DECK (SETQ P1 (RR))))
07900 (SETQ P (CONS P1 (CDR P)))
08000 L (SETQ ACT (READ))
08100 (COND ((MEMBER ACT (CDR ACTS)) (ACT P D)))
08200 (COND ((OR (OVER P) (EQUAL ACT (QUOTE STICK)))
08300 (COND (H (SETQ RES (CONS P RES))
08400 (SETQ P (LIST (CAR H)))
08500 (SETQ H (CDR H))
08600 (PRINT (QUOTE (WORKING ON THE NEXT)))
08700 (PRINT (LAST P))
08800 (GO M))
08900 (T (STICK P D)))
09000 (T (GO L]
09100
09200 (DE VALUE (L) (COND
09300 (L (PLUS (NTH (QUOTE (11.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 10.0
09400 10.0 10.0)) (CAR L)) (VALUE (CDR L))))
09450 (T 0]
09500
09600 (DE BVALUE (L) (COND ((OR (ZEROP (NACES L)) (LESS (VALUE L)
09700 22.0)) (VALUE L))
09800 (T (SETQ NA (NACES L))(PROG () (SETQ V (VALUE L))
09900 LL (SETQ NA (SUB1 NA))
10000 (SETQ V (DIFFERENCE V 10.0))
10100 (COND ((OR (LESS V 22.0)
10200 (EQUAL NA 0)) (RETURN V))) (GO LL]
10300 (DE OVER (L) (NOT (LESS (BVALUE L) 22.0]
10400
10500 (DE STICK (PP DD) (PROG ()
10600 (PRINT (QUOTE (DEALER HAS)))
10700 (PRINT (NTH DECK (CAR D)))
10800 (SETQ D (CONS (RR) D))
10900 (PRINT (NTH DECK (CAR D)))
11000 (COND ((LESS (BVALUE D) 17.0)
11100 (PRINT (QUOTE (DEALER HITS AND GETS A)))
11200 (SETQ D (CONS (RR) D))
11300 (PRINT (NTH DECK (CAR D))) (STICK P D))
11400 ((LESS 21.0 (BVALUE D))
11500 (PRINT (QUOTE (DEALER BUSTS)))
11600 (STAT 2.0))
11700 (T (PRINT (QUOTE (DEALER STICKS)))
11800 (TALLY P D]
11900
12000 (DE TALLY (PP DD) (PROG ()
12100 (SETQ V1 (BVALUE D))
12200 (SETQ V2 (BVALUE P))
12300 (STAT (DIFFERENCE V2 V1))
12400 (COND (RES (SETQ P (CAR RES))
12500 (SETQ RES (CDR RES))
12600 (TALLY P D]
12700
12800 (DE STAT (N) (AND (PRINT (QUOTE MONEY))
12900 (SETQ MONEY (PRINT (COND
13000 ((EQUAL N 2.0) (PLUS MONEY (TIMES WAGER1 U)))
13100 (T (DIFFERENCE MONEY (TIMES WAGER1 N]
13200
13300 (DE NACES (L) (COND ((NULL L) 0)
13400 ((EQUAL (CAR L) 1) (PLUS 1 (NACES (CDR L))))
13500 (T (NACES (CDR L]
13600
13700 (DE LESS (A B) (*LESS A B]